#!/exlibris/sfx_ver/sfx_version_3/app/perl/bin/perl

#######################################################################
#
#	CSU SFX ERM RESOLUTION SCRIPT
#
#	This script takes as its input an SFX instance name, object ID and 
#	either the ID or internal service name of a target; fetches the vendor 
#	URL from the SFX instance, and forwards the user to the external site.
#
#	---------------------------------------------------
#	Version:    Beta 5
#	Author:     David Walker < dwalker@calstate.edu >	
#	Copyright:  (c) 2009 California State University
#	Updated:    2009-08-17
# 	---------------------------------------------------
#	
#	This script is free software: you can redistribute it and/or modify
#	it under the terms of the GNU General Public License as published by
#	the Free Software Foundation, either version 3 of the License, or
#	(at your option) any later version.
#
#	This program is distributed in the hope that it will be useful,
#	but WITHOUT ANY WARRANTY; without even the implied warranty of
#	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#	GNU General Public License for more details.
#
#	< http://www.gnu.org/licenses/ >.
#
########################################################################

use strict;
use warnings;

# change this to your sfx server base address

my $server = "http://sfx.calstate.edu:9003";



use CGI;
use XML::LibXML;
use XML::LibXML::XPathContext;

my $cgi = new CGI;
my $parser = XML::LibXML->new();

my $env_instance = $ENV{"SFX_INST"};

my $instance = $cgi->param("instance");
my $object_id = $cgi->param("object_id");
my $target = $cgi->param("target");
my $test = $cgi->param("test");

# default instance is the one that this script lives in, but 
# can be overriden in the request itself

if ( $instance eq "" )
{
	$instance = $env_instance;
}

if ( $instance ne "" && $object_id ne "" && $target ne "" )
{
	# we'll specify a url to the regular sfx meuu first; 
	# if something goes wrong, we'll redirect the user there 
	
	my $sfx = "$server/$instance?url_ver=Z39.88-2004&rfr_id=info:sid/sfxit.com:azlist" . 
		"&sfx.ignore_date_threshold=1&rft.object_id=$object_id";
	
	# but we also specify a url for the xml response
	
	my $sfx_xml = $sfx . "&sfx.response_type=simplexml";
	
	# and then get the xml data from sfx
	
	my $doc = $parser->parse_file( $sfx_xml );
	
	# if we specify &test=true in the url, then this script will just spit
	# back the xml from sfx; useful for debugging
	
	if ( $test ne "" )
	{
		print $cgi->header('text/xml');
		print $doc->toString();
		exit;
 		
 		# this line is useful for doing debugging in cgi scripts
 		# print $cgi->header, $cgi->start_html('Test'); print "yes!"; print $cgi->end_html;
	}
	
	# extract just the target that was specified in the request
	
	my $xpath = XML::LibXML::XPathContext->new($doc);
	my $nodes = $xpath->findnodes("//target[target_service_id = '$target' or target_name = '$target']/target_url");
	
 	# if we got one (and only one), forward the user to the vendor url
 	
 	if ( $nodes->size() == 1 )
 	{
 		my $url = $nodes->string_value();
 		
 		if ( $url eq "" )
 		{
 			print $cgi->redirect( -URL => $sfx );
 		}
 		else
 		{
	 		print $cgi->redirect( -URL => $url );
	 	}
 	}
 	else
 	{
 		# send them to the sfx menu to work it out

 	 	# if two or more matched, then this is something like abi/inform where there are 
 		# multiple targets tied to specific dates, so the user needs to pick the one they need;
 		# if none matched, then something went horribly wrong
	
 	 	print $cgi->redirect( -URL => $sfx );
 	}
}